1. Task


2016년 관중수가 800만명을 돌파한 프로야구는, 명실공히 한국 프로스포츠 최고의 인기 종목입니다.

프로야구의 인기와 더불어 데이터 분석에 대한 인식이 높아짐에 따라 국내 여러 구단에서 데이터 사이언스 역할의 수요가 늘고 있습니다.

특히 야구에서는 특정 선수의 성적 변동성이 해마다 매우 크기 때문에 내년 성적을 예측하기 까다로운 부분이 많습니다.

정말 못할 것이라고 생각했던 선수도 막상 내년에는 잘하고,

많은 지표가 리그 상위권이었던 선수가 내년에는 그렇지 않은 경우가 많습니다.

본 대회는 야구 데이터로 불확실성 문제를 해결하기 위해 2019년 타자들의 상반기 성적 예측을 목표로 합니다.

출처 및 상세규칙 : Dacon 6th Competiton - Predicting OPS for KBO Batters


1-1. Target Variable

OPS는 ’On Base plus Slugging’의 약자로 말 그대로 출루율과 장타율을 더한 수치이다. OPS .900이상을 A급, 그 이하는 .100단위로 나누어 타자의 등급을 매기는 것이 일반적이다. OPS는 출루율과 장타율의 비중을 1대1로 둔다는 점에서 많은 비판을 받는데(득점, 즉 생산력에 있어서는 출루율이 장타율보다 좀 더 높은 연관성을 지닌다) 그럼에도 불구하고 이 용어가 지속적으로 사용되는 이유는 식의 간편성 때문이다. 보통의 많은 공식들이 복잡한 수식을 사용하는데 비해 OPS는 덧셈을 할 줄 아는 사람이라면 누구나 곧바로 타자의 등급을 매겨 볼 수 있다는 점에서 널리 사랑받고 있다. text

출처 : 네이버 지식백과

1-2. Evaluation


Evaluation Method로 Weighted Root Mean Square Error(WRMSE)를 활용하며 공식은 아래와 같다.
text


2. Options / Packages

options(scipen = 100)
if (!require(dplyr)) install.packages('dplyr')
if (!require(knitr)) install.packages('knitr')
if (!require(kableExtra)) install.packages('kableExtra')
if (!require(reshape2)) install.packages('reshape2')
if (!require(stringr)) install.packages('stringr')
if (!require(tm)) install.packages('tm')
if (!require(lubridate)) install.packages('lubridate')
if (!require(ggplot2)) install.packages('ggplot2')
if (!require(ggcorrplot)) install.packages('ggcorrplot')
if (!require(scales)) install.packages('scales')
if (!require(ggpubr)) install.packages('ggpubr')
if (!require(plotly)) install.packages('plotly')
if (!require(xgboost)) install.packages('xgboost')
if (!require(rvest)) install.packages('rvest')


3. Data Loading

regular_season <- read.csv('C:/Users/Mano/Desktop/새 폴더/Regular_Season_Batter.csv',
                           fileEncoding = 'UTF-8',
                           stringsAsFactor = F,
                           na.strings = '-')
regular_season_crawl <- read.csv('C:/Users/Mano/Desktop/새 폴더/season.csv',
                            stringsAsFactor = F,
                            na.strings = '-')
day_by_day <- read.csv('C:/Users/Mano/Desktop/새 폴더/Regular_Season_Batter_Day_By_Day.csv',
                       fileEncoding = 'UTF-8',
                       stringsAsFactor = F,
                       na.strings = '-')
Column_name Description
batter_id 타자의 고유 아이디
batter_name 타자 이름
year 년도
team 소속팀
avg 타율
G 출전게임수
AB 타수(타석-볼넷-사구-희생번트-희생플라이)
R 득점
H 안타(1루타+2루타+3루타+홈런)
2B 2루타
3B 3루타
HR 홈런
TB 루타 수
RBI 타점
SB 도루 성공
CS 도루 실패
BB 볼넷
HBP 사구(몸에 맞는 볼)
SO 삼진아웃
GDP 병살타
SLG 장타율
OBP 출루율
E 에러
height/weight 선수의 키/몸무게
year_born 선수의 생년월일
position 선수의 수비위치
career 선수의 커리어
starting_salary 선수의 한국프로야구 입단연봉
OPS OPS(OBP+SLG)
PA 타석
SAC 희생번트
SF 희생플라이
IBB 고의4구
MH 멀티히트
RISP 득점권타율
PH.BA 대타타율
XBH 장타
GO 땅볼
AO 뜬공
GO.AO 땅볼/뜬공
GW.RBI 결승타
BB.K 볼넷/삼진
P.PA 투구수/타석
ISOP 순수장타율
XR 추정즉점
GPA (1.8x출루율+장타율) / 4
Column_name Description
batter_id 타자의 고유 아이디
batter_name 타자 이름
date 날짜
opposing_team 상대 팀
avg1 해당 경기 타율
AB 해당 경기 타수
R 해당 경기 득점
H 해당 경기 안타
2B 해당 경기 2루타
3B 해당 경기 3루타
HR 해당 경기 홈런
RBI 해당 경기 타점
SB 해당 경기 도루 성공
CS 해당 경기 도루 실패
BB 해당 경기 볼넷
HBP 해당 경기 사구
SO 해당 경기 삼진아웃
GDP 해당 경기 병살타
avg2 시즌 누적 타율
year 년도


4. Data Pre-Processing

4-1. Regular_Season

    1. height.weight 변수를 height, weight 변수로 구분하기
    • Character 형식의 height.weight 변수를 Numeric 형식의 height, weight 변수로 구분했다.
regular_season$height <- substr(regular_season$height.weight, 1, 5) %>% 
  str_remove('cm') %>%
  as.numeric()

regular_season$weight <- substr(regular_season$height.weight, 7, 20) %>% 
  str_remove('kg') %>%
  as.numeric()

regular_season$height.weight <- NULL
    1. year_born 변수를 ymd 형식으로 바꿔준 후 age(해당 시즌 당시의 나이) 변수 만들기
regular_season$year_born <- regular_season$year_born %>% 
  str_remove('년 ') %>% 
  str_remove('월 ') %>% 
  str_remove('일') %>% 
  ymd()

regular_season$age <- regular_season$year - year(regular_season$year_born) + 1
    1. position 변수를 position(내야수/외야수/포수), hand(우타/좌타/양타) 변수로 나눠주기
regular_season$hand <- ifelse(substr(regular_season$position, 1, 2) == '포수',
                              substr(regular_season$position, 6, 7),
                              substr(regular_season$position, 7, 8))

regular_season$position <- ifelse(substr(regular_season$position, 1, 1) == '포',
                                  '포수',
                                  substr(regular_season$position, 1, 3))
    1. starting_salary 변수를 10,000원 단위로 바꿔주기
    • 달러는 1,000원으로 처리했다.
regular_season$starting_salary <- regular_season$starting_salary %>%
  str_remove('만원') %>% 
  str_remove('0달러') %>% 
  as.numeric()
    1. 1루타 변수 만들기
    • 총 안타(H)에서 2루타(X2B), 3루타(X3B), 홈런(HR)의 개수를 제거했다.
regular_season <- regular_season %>% 
  mutate(X1B = H - X2B - X3B - HR)
    1. 데이터 확인
str(regular_season)
## 'data.frame':    2454 obs. of  33 variables:
##  $ batter_id      : int  0 1 1 1 1 1 1 2 2 2 ...
##  $ batter_name    : chr  "가르시아" "강경학" "강경학" "강경학" ...
##  $ year           : int  2018 2011 2014 2015 2016 2017 2018 2013 2015 2016 ...
##  $ team           : chr  "LG" "한화" "한화" "한화" ...
##  $ avg            : num  0.339 0 0.221 0.257 0.158 0.214 0.278 0 0.2 0 ...
##  $ G              : int  50 2 41 120 46 59 77 2 4 2 ...
##  $ AB             : int  183 1 86 311 101 84 245 2 5 3 ...
##  $ R              : int  27 0 11 50 16 17 42 0 0 0 ...
##  $ H              : int  62 0 19 80 16 18 68 0 1 0 ...
##  $ X2B            : int  9 0 2 7 3 2 11 0 1 0 ...
##  $ X3B            : int  0 0 3 4 2 1 1 0 0 0 ...
##  $ HR             : int  8 0 1 2 1 0 5 0 0 0 ...
##  $ TB             : int  95 0 30 101 26 22 96 0 2 0 ...
##  $ RBI            : int  34 0 7 27 7 4 27 0 0 0 ...
##  $ SB             : int  5 0 0 4 0 1 6 0 0 0 ...
##  $ CS             : int  0 0 0 3 0 1 3 0 0 0 ...
##  $ BB             : int  9 0 13 40 8 8 38 0 0 0 ...
##  $ HBP            : int  8 0 2 5 2 1 4 0 0 0 ...
##  $ SO             : int  25 1 28 58 30 19 59 0 0 1 ...
##  $ GDP            : int  3 0 1 3 5 1 7 0 0 0 ...
##  $ SLG            : num  0.519 0 0.349 0.325 0.257 0.262 0.392 0 0.4 0 ...
##  $ OBP            : num  0.383 0 0.337 0.348 0.232 0.29 0.382 0 0.2 0 ...
##  $ E              : int  9 1 6 15 7 4 2 0 0 0 ...
##  $ year_born      : Date, format: "1985-04-12" "1992-08-11" ...
##  $ position       : chr  "내야수" "내야수" "내야수" "내야수" ...
##  $ career         : chr  "쿠바 Ciego de Avila Maximo Gomez Baez(대)" "광주대성초-광주동성중-광주동성고" "광주대성초-광주동성중-광주동성고" "광주대성초-광주동성중-광주동성고" ...
##  $ starting_salary: num  NA 10000 10000 10000 10000 10000 10000 9000 9000 9000 ...
##  $ OPS            : num  0.902 0 0.686 0.673 0.489 0.552 0.774 0 0.6 0 ...
##  $ height         : num  177 180 180 180 180 180 180 180 180 180 ...
##  $ weight         : num  93 72 72 72 72 72 72 82 82 82 ...
##  $ age            : num  34 20 23 24 25 26 27 21 23 24 ...
##  $ hand           : chr  "우타" "좌타" "좌타" "좌타" ...
##  $ X1B            : int  45 0 13 67 10 15 51 0 0 0 ...


4-2. Regular_season_crawl

    1. 1루타 변수 만들기
regular_season_crawl <- regular_season_crawl %>% 
  mutate(X1B = H - X2B - X3B - HR)
    1. 데이터 확인
str(regular_season_crawl)
## 'data.frame':    5091 obs. of  39 variables:
##  $ YEAR  : int  2002 2002 2002 2002 2002 2002 2002 2002 2002 2002 ...
##  $ 선수명: chr  "윤태수" "김동주" "송원국" "강인권" ...
##  $ 팀명  : chr  "두산" "두산" "두산" "두산" ...
##  $ AVG   : num  0.333 0.318 0.308 0.294 0.289 0.288 0.275 0.274 0.262 0.256 ...
##  $ G     : int  3 120 45 38 127 130 130 126 91 119 ...
##  $ PA    : int  3 487 70 56 484 548 488 403 179 469 ...
##  $ AB    : int  3 415 65 51 432 486 444 369 164 407 ...
##  $ R     : int  0 63 9 4 51 50 55 69 13 53 ...
##  $ H     : int  1 132 20 15 125 140 122 101 43 104 ...
##  $ X1B   : int  0 85 12 14 90 104 106 69 34 58 ...
##  $ X2B   : int  1 21 5 1 17 24 12 18 4 18 ...
##  $ X3B   : int  0 0 0 0 0 4 3 1 1 3 ...
##  $ HR    : int  0 26 3 0 18 8 1 13 4 25 ...
##  $ TB    : int  2 231 34 16 196 196 143 160 61 203 ...
##  $ RBI   : int  0 79 13 1 70 58 30 47 16 82 ...
##  $ SAC   : int  0 0 0 1 7 7 7 0 5 0 ...
##  $ SF    : int  0 7 0 0 3 6 3 2 0 7 ...
##  $ AVG.1 : num  0.333 0.318 0.308 0.294 0.289 0.288 0.275 0.274 0.262 0.256 ...
##  $ BB    : int  0 52 5 4 37 44 31 26 10 50 ...
##  $ IBB   : int  0 2 0 0 1 0 0 1 1 3 ...
##  $ HBP   : int  0 13 0 0 5 5 3 6 0 5 ...
##  $ SO    : int  0 61 14 10 63 65 65 66 31 123 ...
##  $ GDP   : int  0 8 0 0 17 13 10 5 4 11 ...
##  $ SLG   : num  0.667 0.557 0.523 0.314 0.454 0.403 0.322 0.434 0.372 0.499 ...
##  $ OBP   : num  0.333 0.405 0.357 0.345 0.35 0.349 0.324 0.33 0.305 0.339 ...
##  $ OPS   : num  1 0.962 0.88 0.659 0.804 0.752 0.646 0.764 0.677 0.838 ...
##  $ MH    : int  0 32 3 3 32 40 30 27 6 24 ...
##  $ RISP  : num  0 0.283 0.381 0.235 0.321 0.244 0.19 0.295 0.167 0.32 ...
##  $ PH.BA : num  0.5 0.25 0.368 0 0 0 0.375 0.167 0.429 0 ...
##  $ XBH   : int  1 47 8 1 35 36 16 32 9 46 ...
##  $ GO    : int  2 97 14 18 132 152 143 83 52 98 ...
##  $ AO    : int  0 132 17 8 115 135 117 121 38 89 ...
##  $ GO.AO : num  NA 0.73 0.82 2.25 1.15 1.13 1.22 0.69 1.37 1.1 ...
##  $ GW.RBI: int  0 0 0 0 0 0 0 0 0 0 ...
##  $ BB.K  : num  NA 0.85 0.36 0.4 0.59 0.68 0.48 0.39 0.32 0.41 ...
##  $ P.PA  : num  4.33 3.9 3.44 4.02 3.71 3.59 3.75 3.67 3.77 4.06 ...
##  $ ISOP  : num  0.333 0.239 0.215 0.02 0.164 0.115 0.047 0.16 0.11 0.243 ...
##  $ XR    : num  0.5 90.5 11.8 6.2 64.3 67.3 45.7 52.7 17 70 ...
##  $ GPA   : num  0.317 0.322 0.291 0.234 0.271 0.258 0.226 0.257 0.23 0.277 ...


4-3. Regular_season_day_by_day

    1. 경기 날짜 ymd 형식으로 만들기
day_by_day$date <- paste0(day_by_day$year, day_by_day$date) %>% 
  removePunctuation() %>% 
  ymd()
    1. 1루타 변수 만들기
day_by_day <- day_by_day %>% 
  mutate(X1B = H - X2B - X3B - HR)
    1. 누적 변수 만들기
    • 누적타율(avg2)와 같이 Integer 형식의 변수에 한해 누적 변수를 생성했다.
day_by_day <- day_by_day %>% arrange(batter_id, date)
test <- day_by_day %>% arrange(batter_id, date)

test <- test %>%
  group_by(batter_id, year) %>% 
  select_if(is.integer) %>% 
  mutate_all(cumsum) %>% 
  rename_at(.funs = function(x) paste0(x, '2'),
            .vars = c('AB', 'R', 'H', 'X1B', 'X2B', 'X3B', 'HR', 'RBI', 'SB', 
                      'CS', 'BB', 'HBP', 'SO', 'GDP')) %>% 
  select(-c(batter_id, year))

day_by_day <- bind_cols(day_by_day, test)  
rm(test)
    1. 데이터 확인
str(day_by_day)
## 'data.frame':    109771 obs. of  37 variables:
##  $ batter_id    : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ batter_name  : chr  "가르시아" "가르시아" "가르시아" "가르시아" ...
##  $ date         : Date, format: "2018-03-03" "2018-03-24" ...
##  $ opposing_team: chr  "KIA" "NC" "NC" "넥센" ...
##  $ avg1         : num  0.6 0.333 0 0.2 0.2 0.25 1 0.75 0.25 0.4 ...
##  $ AB           : int  5 3 4 5 5 4 3 4 4 5 ...
##  $ R            : int  2 1 0 0 1 0 1 1 0 1 ...
##  $ H            : int  3 1 0 1 1 1 3 3 1 2 ...
##  $ X2B          : int  1 0 0 0 0 0 1 0 0 0 ...
##  $ X3B          : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ HR           : int  0 0 0 0 0 0 0 0 0 1 ...
##  $ RBI          : int  1 0 0 0 1 3 2 2 0 1 ...
##  $ SB           : int  0 0 0 0 0 0 0 0 1 0 ...
##  $ CS           : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ BB           : int  0 1 0 0 0 0 0 1 0 1 ...
##  $ HBP          : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ SO           : int  1 1 1 0 0 0 0 1 2 1 ...
##  $ GDP          : int  0 0 0 0 0 1 0 0 0 0 ...
##  $ avg2         : num  0.269 0.333 0.143 0.167 0.176 0.19 0.345 0.394 0.393 0.395 ...
##  $ year         : int  2018 2018 2018 2018 2018 2018 2018 2018 2018 2018 ...
##  $ X1B          : int  2 1 0 1 1 1 2 3 1 1 ...
##  $ batter_id1   : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ year1        : int  2018 2018 2018 2018 2018 2018 2018 2018 2018 2018 ...
##  $ AB2          : int  5 8 12 17 22 26 29 33 37 42 ...
##  $ R2           : int  2 3 3 3 4 4 5 6 6 7 ...
##  $ H2           : int  3 4 4 5 6 7 10 13 14 16 ...
##  $ X2B2         : int  1 1 1 1 1 1 2 2 2 2 ...
##  $ X3B2         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ HR2          : int  0 0 0 0 0 0 0 0 0 1 ...
##  $ RBI2         : int  1 1 1 1 2 5 7 9 9 10 ...
##  $ SB2          : int  0 0 0 0 0 0 0 0 1 1 ...
##  $ CS2          : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ BB2          : int  0 1 1 1 1 1 1 2 2 3 ...
##  $ HBP2         : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ SO2          : int  1 2 3 3 3 3 3 4 6 7 ...
##  $ GDP2         : int  0 0 0 0 0 1 1 1 1 1 ...
##  $ X1B2         : int  2 3 3 4 5 6 8 11 12 13 ...


5. EDA

목차


1. 도메인 지식

1-1. 타점(RBI), 득점(R) 변수 삭제
regular_season_crawl$RBI <- NULL
regular_season_crawl$R <- NULL
  • 타자 개개인의 OPS를 예측하는 것이기 때문에, 진루상황에 의해 크게 변동 가능한 타점(RBI), 득점(R) 변수는 삭제했다.
1-2. 장타(XBH) 변수 삭제
all.equal(regular_season_crawl$XBH, 
          apply(regular_season_crawl %>% select(X2B, X3B, HR), 1, sum))
## [1] TRUE
regular_season_crawl$XBH <- NULL
  • 장타(XBH) 변수는 2루타(X2B) + 3루타(X3B) + 홈런(HR)의 공식으로 계산된 변수다. 이는 1루타(X1B), 2루타(X2B), 3루타(X3B), 홈런(HR)에 각각 1, 2, 3, 4의 가중치로 계산된 가중합 변수 루타(TB)로 대체 가능하다는 판단 하에 삭제했다.
1-3. 출전 경기 수(G), 타수(AB) 변수 삭제
regular_season_crawl %>%
  select(PA, G, AB) %>% 
  pairs()

regular_season_crawl$AB <- NULL
regular_season_crawl$G <- NULL
  • 0.94 이상의 상관계수로 강한 선형성을 보이는 출전 경기 수(G), 타석(PA), 타수(AB) 3개의 변수 중 기용 중요도를 판단하는데 있어 출전 경기 수(G)에 비해 타석(PA)과 타수(AB)가 정확하고, 4구(BB), 고의사구(IBB), 사구(HBP)를 모두 포함하는 타석(PA)이 가장 정확하기 때문에 출전 경기 수(G), 타수(AB) 변수는 삭제했다.
ggplotly(regular_season_crawl %>% 
           ggplot() +
           geom_point(aes(x = PA,
                          y = OPS,
                          col = ifelse(PA >= 100, 'Team', '4실'))) +
           geom_vline(xintercept = 100,
                      col= 'red',
                      linetype = 'dotted') +
           theme_bw() +
           theme(legend.position = 'none') +
           geom_smooth(aes(x = PA,
                           y = OPS),
                       method = 'auto'))
day_by_day %>%
    ggplot() +
    geom_point(aes(x = AB2,
                   y = avg2,
                   col = ifelse(AB2 >= 100, 'Team', '4실')),
               alpha = .1) +
    geom_vline(xintercept = 100,
               col = 'red',
               linetype = 'dotted') +
    theme_bw() +
    theme(legend.position = 'none')

  • 일정 타석(PA) 이상 나오지 못한 타자들의 시즌 성적이 타자 개개인의 실력에 수렴하지 못해 변동이 클 것이라는 가설을 확인하기 위해 경기별 데이터에서 누적 타석(AB2)과 누적 타율(avg2)의 관계를, 정규시즌 데이터에서 타석(PA) 수와 OPS 간의 관계를 확인했다. 결과적으로, 100타석(PA)이상 출전한 타자들의 성적이 비교적 안정적이라고 판단해 100타석(PA) 이상 출전한 타자들에 한한 EDA를 진행하기로 결정했다.


2. 탐색

100타석 이상 출전한 타자들의 데이터 추출
regular_season_crawl100 <- regular_season_crawl %>% 
  filter(PA >= 100)
regular_season100 <- regular_season %>% 
  filter(AB >= 100)
2-1 OPS 이상치 삭제
regular_season100 %>% filter(OPS == 0) %>% select(batter_id, batter_name, year, OPS, avg)
##   batter_id batter_name year OPS   avg
## 1       234      이진영 1999   0 0.258
## 2       234      이진영 2000   0 0.247
## 3       270      정성훈 1999   0 0.292
## 4       270      정성훈 2000   0 0.260
regular_season100 <- regular_season100 %>% filter(OPS != 0)
  • 제공받은 정규시즌 데이터 중 100타수(AB) 이상 출전했음에도 OPS가 0으로 기록된 row를 4개 찾을 수 있었다. 다른 변수도 0으로 기입된 것으로 보아 잘못된 기록이라고 판단, 삭제하였다.
2-2 타석(A)
ggplotly(regular_season_crawl %>% 
           group_by(YEAR) %>% 
           summarise(PA = sum(PA)) %>% 
           ggplot(aes(x = YEAR,
                      y = PA,
                      fill = PA)) +
           geom_bar(stat = 'identity') +
           scale_fill_gradient(low = 'black',
                               high = 'red') +
           labs(x = '연도',
                y = '타석 수',
                title = '연도별 타석 수') +
           theme_bw())

* 2015년 부터 팀당 경기수가 128경기(2014년 기준)에서 144경기(2015년 기준)으로 증가함에 따라 타석의 수가 10,000건 가량 증가했음을 확인할 수 있다. 타석 수가 증가함에 따라 다른 기록들의 빈도도 증가하기에, 이를 보정하기 위해 변수 탐색 시 빈도와 비율 두 가지 관점으로 접근한다.

2-3. 안타 관련 변수(1루타(X1B), 2루타(X2B), 3루타(X3B), 홈런(HR))
regular_season_crawl100 %>%
  select(X1B, X2B, X3B, HR, OPS) %>% 
  pairs()

quantile(regular_season_crawl100$X3B, probs = seq(0, 1, 0.1))
##   0%  10%  20%  30%  40%  50%  60%  70%  80%  90% 100% 
##    0    0    0    0    0    1    1    2    2    3   17
  • 안타 관련 변수는 모두 Non-Negative Value를 가지고, 타석(PA)이 증가함에 따라 안타 관련 변수도 함께 증가하기 때문에, 모든 변수 간 양의 선형성을 확인할 수 있다. 또한, OPS 계산 과정에 루타에 따른 가중치가 적용되므로 1루타(X1B), 2루타(X2B), 홈런(HR) 순으로 강한 선형성을 확인할 수 있다. 그러나 3루타(X3B)는 90분위수가 3개인 만큼 드물게 발생하기에 다른 변수에 비해 OPS와의 선형성이 약함을 확인할 수 있다.
vars <- c('YEAR', 'PA', 'H', 'X1B', 'X2B', 'X3B', 'HR')
mano <- regular_season_crawl100 %>% 
  select(vars) %>% 
  group_by(YEAR) %>% 
  summarise_all(.funs = sum)
ggplotly(melt(mano, id.vars = c('YEAR', 'PA', 'H')) %>%
  ggplot(aes(x = YEAR,
             y = value,
             col = variable)) +
    geom_point(aes(size = PA)) +
    geom_line() +
    labs(title = '연도 별 안타 빈도',
         y = 'Freq') +
    theme_bw())
  • 2015년부터 팀 당 경기수가 증가함에 따라 모든 안타 관련 변수가 크게 증가했음을 확인할 수 있다. 안타(H)의 대부분은 1루타가 차지하고 있고, 3루타는 다른 변수에 비해 희소함을 확인할 수 있다. 안타 관련 변수들의 비율을 통한 탐색도 필요하다.
mano <- mano %>% 
  mutate(X1B_ratio = X1B / H * 100,
         X2B_ratio = X2B / H * 100,
         HR_ratio = HR / H * 100) %>% 
  select(YEAR, ends_with('ratio')) 
melt(mano, id.vars = 'YEAR') %>%
  ggplot() +
  geom_bar(aes(y = value, 
               x = YEAR, 
               fill = variable), 
           stat = "identity") +
  geom_text(aes(x = YEAR, 
                y = round(value) - 4, 
                label = paste0(round(value), "%")),
            colour = "black", 
            size = 3) +
  scale_y_continuous(labels = dollar_format(suffix = "%", 
                                            prefix = "")) +
  labs(y = "Percentage") +
  theme_bw() +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        legend.title = element_blank())

  • 3루타는 모든 시즌에서 2% 미만의 비율을 가지고 있어 그림에 포함하지 않았다. 2012년을 기준으로 홈런의 비율이 점차 증가함을 확인할 수 있고, 이를 통해 타고투저(투수들의 성적이 타자에 비해 부진한 현상) 현상을 확인할 수 있다.
2-4. 출루 관련 변수(4구(BB), 고의4구(IBB), 사사구(HBP))
regular_season_crawl100 %>%
  select(BB, IBB, HBP, OPS) %>% 
  pairs()

vars <- c('YEAR', 'PA', 'BB', 'IBB', 'HBP')
mano <- regular_season_crawl100 %>% 
  select(vars) %>% 
  group_by(YEAR) %>% 
  summarise_all(.funs = sum)
ggplotly(melt(mano, id.vars = c('YEAR', 'PA')) %>%
  ggplot(aes(x = YEAR,
             y = value,
             col = variable)) +
    geom_point(aes(size = PA)) +
    geom_line() +
    labs(title = '연도 별 4구/고의4구/사구 빈도',
         y = 'Freq') +
    theme_bw())
  • 4구(BB), 사구(HBP), 고의4구(IBB) 순으로 많이 관측됨을 확인할 수 있고, 특히 2015 ~ 2016 시즌에 4구가 많이 발생했음을 확인할 수 있다. 타고투저 현상이 가장 심했던 시즌과 겹치는데, 투수들의 역량을 4구(BB)로 어느 정도 가늠할 수 있음을 확인할 수 있다.
vars <- c('YEAR', 'BB', 'IBB', 'HBP')
mano <- regular_season_crawl100 %>% 
  select(vars) %>% 
  group_by(YEAR) %>% 
  summarise_all(.funs = sum) %>% 
  mutate(BB_ratio = BB / (BB + IBB + HBP) * 100,
         IBB_ratio = IBB / (BB + IBB + HBP) * 100,
         HBP_ratio = HBP / (BB + IBB + HBP) * 100) %>% 
  select(YEAR, ends_with('_ratio'))
melt(mano, id.vars = 'YEAR') %>%
  ggplot() +
  geom_bar(aes(y = value, 
               x = YEAR, 
               fill = variable), 
           stat = "identity") +
  geom_text(aes(x = YEAR, 
                y = round(value), 
                label = paste0(round(value), "%")),
            colour = "black", 
            size = 3) +
  scale_y_continuous(labels = dollar_format(suffix = "%", 
                                            prefix = "")) +
  labs(y = "Percentage") +
  theme_bw() +
  theme(legend.position = "bottom", 
        legend.direction = "horizontal",
        legend.title = element_blank())

  • 시즌이 거듭될 수록, 타자에게 일부로 출루를 허용하는 고의4구(IBB)의 비율이 증가함을 확인할 수 있다. 실력이 좋은 타자와의 싸움을 피하거나, 타자를 출루시켜 더 많은 아웃카운트를 만들어 낼 수 있는 전략의 발전으로 해석할 수 있다.
2-5. 아웃 관련 변수(삼진(SO), 땅볼(GO), 뜬공(AO), 땅볼/뜬공(GO.AO),병살타(GDP), 희생번트(SAC), 희생플라이(SF))
regular_season_crawl100 %>%
  select(SO, GO, AO, GO.AO, GDP, SAC, SF, OPS) %>% 
  cor() %>% 
  ggcorrplot(lab = T,
             colors = c('red', 'white', 'blue'),
             hc.order = F)

  • 타석(PA)이 증가함에 따라 빈도로 집계되는 아웃 관련 변수도 증가하기 때문에 모두 양의 선형성을 가질 것으로 예측했으나, 희생번트(SAC), 땅볼/뜬공(GO/AO) 변수가 OPS와 음의 선형성을 가짐을 확인할 수 있다. 따라서 단타를 주로 노려 땅볼 아웃이 많은 타자들과 희생번트를 많이 시도하는 타자들은 OPS가 비교적 낮을 것이라는 결론을 얻을 수 있다.
vars <- c('YEAR', 'PA', 'SO', 'GO', 'AO', 'GDP', 'SAC', 'SF')
mano <- regular_season_crawl100 %>% 
  select(vars) %>% 
  group_by(YEAR) %>% 
  summarise_all(.funs = sum)
ggplotly(melt(mano, id.vars = c('YEAR', 'PA')) %>%
  ggplot(aes(x = YEAR,
             y = value,
             col = variable)) +
    geom_point(aes(size = PA)) +
    geom_line() +
    labs(title = '연도 별 4구/고의4구/사구 빈도',
         y = 'Freq') +
    theme_bw())
  • 땅볼(GO), 뜬공(AO)이 가장 크고 비슷한 빈도로, 뒤를 이어 삼진(SO), 병살타(GDP), 희생플라이(SF) 순으로 큰 빈도를 가졌다. 출루 관련 변수에서 확인했듯 타고투저 현상이 가장 심하게 나타났던 2015 ~ 2016 시즌의 삼진(SO)개수가 현저히 줄어듬을 확인할 수 있다.
2-6. 타율 지표(타율(AVG), 장타율(SLG), 출루율(OBP), RISP(득점권타율), 대타타율(PH.BA), 순수장타율(ISOP), 추정득점(XR), GPA)
regular_season_crawl100 %>%
  select(AVG, SLG, OBP, RISP, PH.BA, ISOP, XR, GPA, OPS) %>% 
  cor() %>% 
  ggcorrplot(lab = T,
             colors = c('red', 'white', 'blue'),
             hc.order = T)

regular_season_crawl100 %>%
  select(SLG, ISOP) %>% 
  pairs()

regular_season_crawl100$SLG <- NULL
  • 장타율(SLG)에서 타율(AVG)를 빼는 공식으로 계산되는 순수장타율(ISOP)는 장타율(SLG)보다 타자의 힘을 판단하기에 적합한 척도로 판단되어 장타율 변수는 삭제한다.
2-7. 요약

3. 가설 검정

3-1. OPS는 타격 유형(우타/좌타/양타)에 영향을 받을까
my_comparisons <- list( c("우타", "양타"), 
                        c("우타", "좌타"), 
                        c("양타", "좌타"))

ggboxplot(data = regular_season100 %>% 
            filter(hand %in% c('우타', '양타', '좌타')), 
          x = 'hand', 
          y = 'OPS',
          color = 'hand', 
          palette = "jco", 
          bxp.errorbar = TRUE) +
  stat_boxplot(geom = 'errorbar', 
               data = regular_season100 %>% 
                 filter(hand %in% c('우타', '양타', '좌타')), 
               aes(x = hand, 
                   y = OPS,
                   color = hand)) +
  stat_compare_means(comparisons = my_comparisons) + 
  stat_compare_means(label.y = 1.5) +
  labs(x = '타격 유형') +
  theme_bw()

  • 타격 유형에 따라 OPS는 통계적으로 유의한 차이를 보이지 않았지만, 오른손과 왼손 모두 사용이 가능한 양타 타자들의 OPS 산포가 우타/좌타자에 비해 작음을 확인할 수 있다. 따라서 양손타자인지 아닌지 구분하는 이진 변수를 추가하는 것이 적합할 것이라고 판단했다.
3-2. OPS는 포지션(내야수/외야수/포수)에 영향을 받을까
my_comparisons <- list( c("내야수", "외야수"), 
                        c("내야수", "포수"), 
                        c("외야수", "포수"))

ggboxplot(data = regular_season100 %>% 
            filter(position %in% c('내야수', '외야수', '포수')), 
          x = 'position', 
          y = 'OPS',
          color = 'position', 
          palette = "jco", 
          bxp.errorbar = TRUE) +
  stat_boxplot(geom = 'errorbar', 
               data = regular_season100 %>% 
                 filter(position %in% c('내야수', '외야수', '포수')), 
               aes(x = position, 
                   y = OPS,
                   color = position)) +
  stat_compare_means(comparisons = my_comparisons) + 
  stat_compare_means(label.y = 1.7) +
  labs(x = '포지션') +
  theme_bw()

  • 포지션 별 OPS 기록이 수준별로 모두 유의한 차이를 보이는 것을 확인할 수 있다. 외야수, 내야수, 포수 순으로 높은 평균 OPS를 기록했다.
3-3. OPS는 초봉(starting_salary)에 영향을 받을까
regular_season %>% 
  filter(AB >= 100) %>% 
  ggplot(aes(x = starting_salary,
             y = OPS)) +
  stat_smooth(method = 'lm') +
  geom_point() +
  theme_bw()
  • 달러를 1,000원으로 환산한 초봉(10,000원)과 OPS는 무관함을 확인할 수 있다.
4. 요약

6. 모델링

# Data Loading
season <- read.csv('C:/Users/Mano/Desktop/새 폴더/season_fin.csv') %>% 
  arrange(batter_id, desc(YEAR)) %>% 
  mutate(X1B = H - X2B - X3B - HR)
submission <- read.csv('C:/Users/Mano/Desktop/새 폴더/submission.csv',fileEncoding = 'UTF-8') %>% 
  arrange(batter_id)
submission2 <- season %>% filter(batter_id %in% submission$batter_id) %>% group_by(batter_id) %>% tally %>% filter(n==1)

# Trial 2(AB_y1 weight,2002~2018,100PA 기준)

stan_Trial2 <- season %>% 
  filter(batter_id %in% submission$batter_id) %>% 
  arrange(batter_id, desc(YEAR)) %>% 
  group_by(batter_id) %>% 
  summarise(PA_2018 = nth(PA, 1)) %>% 
  filter(PA_2018 > 99)

# XGB1 : 1개년도 사용해서 100타석 이상(AB_y1 weight)----
train <- list()
for(i in 2002:2017){train[[i-2001]]<-dataset(season %>% 
                                               filter(YEAR %in% c(i,i+1))) %>% 
                                               filter(PA_y1>99)}
train <- do.call(rbind.data.frame, train) %>% 
  select(-ends_with('_y2')) %>% 
  na.omit() 

# submission 에서 가장 직전 년도에 99타석 이상 친 선수들의 직전년도

validation <- season %>% filter(batter_id %in% stan_Trial2$batter_id) %>% 
  dataset %>% 
  dplyr::select(-ends_with('_y2')) %>% 
  na.omit()
nm1 <- names(train)[4:ncol(train)]

# train 데이터

dtrain <- xgb.DMatrix(data.matrix(train[,nm1]), 
                      label = train$OPS_y, 
                      weight = train$AB_y1)

# Random search for parameters

best_param <- list()
best_seednumber <- 1234
best_rmse <- Inf
best_rmse_index <- 0

for (iter in 1:10) { # 업로드를 위해 반복을 2번만
  param <- list(objective = "reg:linear",
                eval_metric = "rmse",
                max_depth = sample(6:10, 1),
                eta = runif(1, .01, .3), 
                subsample = runif(1, .6, .9),
                colsample_bytree = runif(1, .5, .8), 
                min_child_weight = sample(1:40, 1),
                max_delta_step = sample(1:10, 1)
  )
  cv.nround <-  2000
  cv.nfold <-  5 
  seed.number  <-  sample.int(10000, 1)
  set.seed(seed.number)
  mdcv <- xgboost::xgb.cv(data = dtrain, params = param,  
                          nfold = cv.nfold, nrounds = cv.nround,
                          verbose = F, early_stopping_rounds = 30, maximize = FALSE)
  
  min_rmse_index  <-  mdcv$best_iteration
  min_rmse <-  mdcv$evaluation_log[min_rmse_index]$test_rmse_mean
  
  if (min_rmse < best_rmse) {
    best_rmse <- min_rmse
    best_rmse_index <- min_rmse_index
    best_seednumber <- seed.number
    best_param <- param
  }
}

nround = best_rmse_index
set.seed(best_seednumber)
xg_model1_Trial2 <- xgboost(data = dtrain,
                            params = best_param,
                            nround = nround, 
                            verbose = F,
                            print_every_n = 50)

# XGB2 : 1개년도 사용해서 100타석 이하(AB_y1 weight)----

train <- list()
for(i in 2002:2017){train[[i-2001]] <- dataset(season %>% 
                                               filter(YEAR %in% c(i, i+1))) %>% 
                                               filter(AB_y1<100)}
train <- do.call(rbind.data.frame,train) %>% 
  select(-ends_with('_y2')) %>% 
  na.omit() 
nm1 <- names(train)[4:ncol(train)]

# Train 데이터

dtrain <- xgb.DMatrix(data.matrix(train[,nm1]), 
                      label = train$OPS_y, 
                      weight = train$AB_y1)

# Random Search for parameters

best_param <- list()
best_seednumber <- 1234
best_rmse <- Inf
best_rmse_index <- 0

for (iter in 1:2) { # 업로드를 위해 반복을 2번만
  param <- list(objective = "reg:linear",
                eval_metric = "rmse",
                max_depth = sample(6:10, 1),
                eta = runif(1, .01, .3), 
                subsample = runif(1, .6, .9),
                colsample_bytree = runif(1, .5, .8), 
                min_child_weight = sample(1:40, 1),
                max_delta_step = sample(1:10, 1)
  )
  cv.nround <-  2000
  cv.nfold <-  5 
  seed.number  <-  sample.int(10000, 1) 
  set.seed(seed.number)
  mdcv <- xgb.cv(data = dtrain,
                 params = param,
                 nfold = cv.nfold, 
                 nrounds = cv.nround,
                 verbose = F,
                 early_stopping_rounds = 30,
                 maximize = FALSE)
  
  min_rmse_index  <-  mdcv$best_iteration
  min_rmse <-  mdcv$evaluation_log[min_rmse_index]$test_rmse_mean
  
  if (min_rmse < best_rmse) {
    best_rmse <- min_rmse
    best_rmse_index <- min_rmse_index
    best_seednumber <- seed.number
    best_param <- param
  }
}

nround = best_rmse_index
set.seed(best_seednumber)
xg_model2_Trial2 <- xgboost(data = dtrain,
                            params = best_param,
                            nround = nround,
                            verbose = F,
                            print_every_n = 50)

# Feature Importance

xgb.ggplot.importance(xgb.importance(model=xg_model1_Trial2))

xgb.ggplot.importance(xgb.importance(model=xg_model2_Trial2))